perm filename SCENE.SAI[SYS,HE]4 blob sn#096066 filedate 1974-04-05 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00013 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	SCENE - cross-reference  mapping schemes
C00005 00003	_ LCOMCV
C00007 00004	_ XREF
C00010 00005	_ XREF cont
C00012 00006	_ XREF cont
C00014 00007	_ XREF cont
C00017 00008	_ XREF cont
C00020 00009	_ XREF cont
C00022 00010	_ XREF cont.
C00024 00011	_ XREF cont.
C00029 00012	_ XREF cont
C00030 00013	_ UNXREF
C00032 ENDMK
C⊗;
COMMENT SCENE - cross-reference  mapping schemes;

ENTRY LCOMCV,XREF,UNXREF;

BEGIN "SCENE"

DEFINE QI="INTEGER",
	QR="REAL",
	QRI="REFERENCE INTEGER",
	QRR="REFERENCE REAL",
	QEP="EXTERNAL SIMPLE PROCEDURE",
	QEIP="EXTERNAL SIMPLE INTEGER PROCEDURE",
	QERP="EXTERNAL SIMPLE REAL PROCEDURE",
	QFOP="FORWARD INTERNAL SIMPLE PROCEDURE",
	QFOIP="FORWARD INTERNAL SIMPLE INTEGER PROCEDURE",
	QFORP="FORWARD INTERNAL SIMPLE REAL PROCEDURE",
	_="COMMENT",
	LOOP(I,J,K,L)="FOR I←J STEP L UNTIL K DO",
	LACT(I)="(LNCRE1≤LCREDE[I] LAND '400000007777≤LNCRE2)",
	BELCRE(IA)="LVNEXT(IA,-1)",
	SAFEX="SAFE";

INTEGER IA,IB,IC,ID,IE,LNCS1,LNCS2;
EXTERNAL INTEGER IFREEV,MAXNOL,MAXNOV,LNCRE1,LNCRE2;

EXTERNAL REAL RWIC,RMLE,RCDI,RMALS,RMRLS;

SAFEX EXTERNAL INTEGER ARRAY LCREDE,LVERSI,LVERCO,LVER,IPK,IPS,LINK[1:1];

SAFEX EXTERNAL REAL ARRAY XVCOR,YVCOR,SVANG,XLCOR,YLCOR,RK,RBK,RAS,RBS,
	RCOL,RLEN[1:1];

QEIP ISIGN(QI I,J);
QEIP LVNEXT(QI I,J);
QEIP LVOPP(QI I);
QEIP MERCV(QI I,J,K);
QEIP NLINCV(QI I);
QERP LDIST(QR X,Y; QI I);
QEIP NEXVER;
QEP RETCV(INTEGER ICV);

QEP ARINT(QRR RK,RAS,RBS,RCOL; QRI IPS);
QEP XREF1(QR A,B; QRI PS,IT,LCV1);
QEIP XREF2;
QEIP XREF3;
QEIP XREF4;
QEIP XREF5;
QEP XREF6;
QEIP XREF7;
QEP XREF8;
_ LCOMCV;

_	Returns number of common line, or 0 if no such line.
	Counts all types and connections.;

INTERNAL SIMPLE INTEGER PROCEDURE LCOMCV(INTEGER ICV1,ICV2);
	BEGIN "LCOMCV"
	LABEL L1;
	INTEGER ISV, ISVM;
	ISV←ABS LVNEXT(ICV1,8);
L1:	IF ISV=0 THEN RETURN(0);
	ISVM ← (ISV+1)%2;
	IF LACT(ISVM)∧LVERCO[LVOPP(ISV)]=ICV2 THEN RETURN(ISVM);

_	No, this line is inactive or not common to ICV1 and ICV2, iterate.;

	ISV←ABS LVNEXT(0,8);
	GO L1;
	END "LCOMCV";
_ XREF;
_	Sets up cross-reference tables, based on line intersections,
	and uses those tables as a basis for the creation of temporary
	compound vertices. Those will later be utilized in the object
	abstraction schemes. Collinearities are also recorded as midway-point
	intersections. The program only works with active lines.;

INTERNAL SIMPLE PROCEDURE XREF;
	BEGIN "XREF" LABEL L200,PSL,BA0;
	INTERNAL INTEGER I1,IV1,IV2,I2,IX1,IX2,IP1,IP2,IL,ICV1,ICV2,ISV1,ISV2;
	INTERNAL REAL R1,R2;
	EXTERNAL INTEGER IDUM;
	EXTERNAL REAL X, Y;
	INTEGER I3,LCV1,LCV2,PS,IT,LB,IS1,IS2,M1;
	REAL RMLES,RMALSS,RMRLSS,RCDIS,RWICS,RX;
	ARINT(RK[1],RAS[1],RBS[1],RCOL[1],IPS[1]);

_	First prepare the distance tables.;

	IT←PS←0;
	RX←RMLES←RMLE↑2;
	RMALSS←RMALS↑2;
	RMRLSS←RMRLS↑2;
	RCDIS←RCDI↑2;
	RWICS←RWIC↑2;
	XREF1(RCDIS,RWICS,PS,IT,LCV1);
	RK[1] ← RAS[1] ← RCOL[1] ← 900000.;
	ARRBLT(RK[2],RK[1],MAXNOV-1);
	ARRBLT(RAS[2],RAS[1],MAXNOV-1);
	ARRBLT(RCOL[2],RCOL[1],MAXNOV-1);

_	The following is the MAIN  X-REF SETUP LOOP....;
_	The loop is used three times.
	1: IT=0 PS=0  Regular pass, using RMLE.
	2: IT=1 PS=0  Amending blocked intersections, using RMLE.
	3: IT=0 PS=6  Final pass extension-intersections, using 2*RMLE for sums.;

BA0:	M1 ← MAXNOL+IT-1;
	LOOP(I1,1,M1,1)
		BEGIN "LP11" 
		IF XREF2 THEN CONTINUE;
		IF IT∧ICV1 THEN
			BEGIN
			RAS[ISV1-1]←900000.;
			IPS[ISV1-1]←0
			END;
		IF IT∧ICV2 THEN
			BEGIN
			RAS[ISV1]←900000.;
			IPS[ISV1]←0
			END;
_ XREF cont;
		LB←I1*(1-IT)+1;
		LOOP(I2,LB,MAXNOL,1)
			BEGIN "LP12"
			LABEL L130,L21,L22,L42,L420,L41,L32,L31,L310;

_			Both lines are active.;
_			Find intersection (or collinear equivalent).;

			IF XREF3 THEN CONTINUE;
			IF IDUM<-1 THEN
				BEGIN
				RK[IV1←IF IDUM=-2 THEN ISV1
					ELSE ISV2]←-1.;
				RK[IV1-1]←-1.;
				CONTINUE;
				END;
			IF PS∧(IP1≤0∨IP2≤0) THEN CONTINUE;
			IF IT∧(IP1≤0∨IP2≤0∨IP1=1∧¬ICV1∨IP1=2∧¬ICV2)
				THEN CONTINUE;

_			IVN are the closest s.v:s.;

L130:			IV1←ISV1+ ABS IP1 -2;
			IV2←ISV2+ ABS IP2 -2;

_			Record collinearity iff IDUM=-1 and there is no
			previous entry or the present distance is smaller.;

			IF XREF4 THEN CONTINUE;

_			Here is where we separate the different cases.;

			IF IP1>0 THEN GO L22;
			IF IP1=0 THEN CONTINUE;

_			IP1 ← 0 iff lines do not intersect.;

L21:			IF IP2≤0 THEN GO L31 ELSE GO L32;
_			IP2 ≠ 0, always if IP1 ≠ 0.;

L22:			IF IP2≤0 THEN GO L41;

_			IP1 > 0 and IP2 > 0.;

L42:			IF ¬PS∧(R1>RX∨R2>RX)∨PS∧R1+R2>RX THEN CONTINUE;

_			Extensions are OK.;

			IF R1≥RAS[IV1] THEN GO L420;
_ XREF cont;
_			New minimum for first line, save.
			Collinear case remembered as negative sign of IPS.;

			RAS[IV1]←R1;
			RBS[IV1]←R2;
			IPS[IV1]←IF IDUM≥0 THEN IV2 ELSE -IV2;
L420:			IF IT∨R2≥RAS[IV2] THEN CONTINUE;

_			New minimum for second line, save.
			Collinear case remembered as negative sign of IPS.;

			RAS[IV2]←R2;
			RBS[IV2]←R1;
			IPS[IV2]←IF IDUM≥0 THEN IV1 ELSE -IV1;
			CONTINUE;

_			IP1 > 0 and IP2 < 0.;

L41:			IF R1≥RK[IV1] THEN CONTINUE;

_			New minimum distance to crossing line, for line 1.;

			RK[IV1]←R1;
			RBK[IV1]←R2;
			IPK[IV1]←IV2;
			CONTINUE;

_			IP1 < 0 and IP2 > 0.;

L32:			IF R2≥RK[IV2] THEN CONTINUE;

_			New minimum distance to crossing line, for line 2.;

			RK[IV2]←R2;
			RBK[IV2]←R1;
			IPK[IV2]←IV1;
			CONTINUE;

_			IP1 <0 and IP2 < 0. Lines cross. Shorten one
			of them to get the case of a T-joint. Then use
			stopping cases above. Note that this case is
			only presumed possible just after the initial
			line-fit, not later.;
_ XREF cont;

L31:			IDUM←(IF R1>R2 THEN IV2 ELSE IV1);
			XVCOR[LVERCO[IDUM]]←X;
			YVCOR[LVERCO[IDUM]]←Y;
			IF R1>R2 THEN GO L310;
			R1←0.;
			IP1←-IP1;
			GO L41;

L310:			R2←0.;
			IP2←-IP2;
			GO L32;

_			CHECK FOR PARALLELITY MAY BE IMPLEMENTED HERE LATER.;

	; 	_	Inner loop ends...;

	                END "LP12";

_		Outer loop ends...;

	        END "LP11";

_	Iterate once, in order to (possibly) replace blocked intersections.;

	IF ¬(IT+PS) THEN BEGIN IT←1; GO BA0 END;
_ XREF cont;
_	   *****   CROSS-REFERENCE TABLES NOW EXIST   *****;

_	Now create temporary vertices and possible T-joints.
	The indexing is in the s.v. structure [line-ends].
	First pass:  Join acceptable extension-intersections, using RMLE/2.
	Second pass: Same, except use RMLE.
	Third pass:  Join ends with small cut stops, iff either end is free,
		     giving preference to shortest RK of line-pair.
	Fourth pass: Same, except no preference.
	Fifth pass:  Join still free ends into closest vertices,
		     provided distance and PLDIS are OK.
	Sixth pass:  Iterate extension intersections once more, using
			2*RMLE for sums.;

	IF ¬PS THEN BEGIN PS←1; RX←RMLES*0.25; IT←0 END;
PSL:	LOOP(I1,1,MAXNOV,1)
		BEGIN "LP101" LABEL L1020,L1010;
		REAL A1, A2, A3, A4;
		IF XREF5 THEN CONTINUE;
		IF PS=3∨PS=4 THEN GO L1010;

_		Line is active. If first, second or sixth pass, check if
		there is an extension-intersection (restore IPS,
		if second pass, while taking care to remember it to MERCV).
		If fifth pass, check for junctions of free lines to vertices.;

		IF PS=5 THEN
			BEGIN
			R1←900000.;
			ICV1←LVERCO[IP2←LVOPP(I1)];
			LCV1←LVERCO[I1];
			XREF6;
			IF R1<RX∧(R1<RK[I1]∨LVERCO[IPK[I1]]=ICV2) THEN
				MERCV(LCV1,ICV2,0);
			CONTINUE;
			END;
		I2←((A1←IPS[I1])<0);
		I3←ABS A1;
		IF PS=2 THEN IPS[I1]←I3;
		IF (A1←RAS[I1])>RX∨RBS[I1]>RX∨RK[I1]<A1 THEN CONTINUE;

_		There are no stopping lines in between the two lines, an
		intersection is listed, and the second line is eligible.
		Therefore sofar OK to join the c.v:s of the two lines in
		a temporary compound vertex, i.e. topologically. The
		c.v:s created here are highly temporary in nature, and
		will be subject to change, as the process reaches higher
		stages.;
_ XREF cont;

L1020:		ICV1←LVERCO[I1];
		ICV2←LVERCO[I3];
		IF ¬((IS1←ABS LVER[I1]=I1)
			∧(IS2←ABS LVER[I3]=I3))
		    ∧(IS1
			∧ABS LDIST(A1←XVCOR[ICV2],A2←YVCOR[ICV2],IL)>RWIC
			∨IS2
			∧ABS LDIST(A3←XVCOR[ICV1],A4←YVCOR[ICV1],(I3+1)%2)>RWIC
			∨¬IS1
			∧¬IS2
			∧(A3-A1)↑2+(A4-A2)↑2>RCDIS) THEN CONTINUE;

_		The distance between a non-single c.v. and the other c.v.
		or line is OK. Therefore join the c.v:s.;

		IDUM←MERCV(ICV1,ICV2,I2);
		CONTINUE;

_		Register stopping line as possible T?;

L1010:		IF RK[I1]≥900000. THEN CONTINUE;

_		Yes, there is a stopping line.;
_		FOR NOW WE DO NOT USE IT - KKP;

		I2 ← IPK[I1];

_		Register as intersection, i.e. merge, as well?;

		A1←RK[I1];
		A2←RBK[I1];
		IF (I3← ABS LVER[I1]≠I1)
			∧ ABS LVER[I2]≠I2
			∨ I3∧PS=3
			∧A1≥RK[I2]
			∨ A1>RMLES
			∨A2>RMALSS
			∨A2>RMRLSS*RLEN[(I2+1)%2]↑2 THEN CONTINUE;

_		At least one end is free, the distance is OK,
		and the cut is small enough. Merge the c.v:s.;

		LCV1←LVERCO[I1];
		LCV2←LVERCO[IPK[I1]];
		IDUM←MERCV(LCV1,LCV2,0);

_		End of primary c.v.-joining loop...;

	        END "LP101";
_ XREF cont.;

	RX←IF PS=1 THEN RMLES ELSE IF PS=4 THEN 2.*RMLES ELSE 4.*RMLES;
	IF (PS←PS+1)<6 THEN GO PSL;
	IF PS=6 THEN GO BA0;

_	   *****   PRIMARY C.V. COUMPOUNDS NOW EXIST   *****;

_	OK, by now all the intersection-indicated c.v:s are created.
	The next step is to merge neighbouring c.v:s, provided they
	are within the maximum distance, CDI, from one another, and
	that a line between them would not cross any other line in
	the topological picture.;

L200:	LOOP(I1,1,MAXNOV-1,1)
		BEGIN "LP201" 

_		C.v. is active?;

		IF ¬BELCRE(I1) THEN CONTINUE;
		LOOP(I2,I1+1,MAXNOV,1)
			BEGIN "LP202" 

_			Second c.v. is active, as well?;

			IF ¬BELCRE(I2) THEN CONTINUE;

_			Yes, it	 is. Are they close enough?;

			IF XREF7 THEN CONTINUE;

_			Yes, they are. Do they have a line in common?;

			IF LCOMCV(I1,I2)≠0 THEN CONTINUE;

_			No, they don't. Are they both single?;

			IF NLINCV(-I1)*NLINCV(-I2)=1 THEN CONTINUE;
_ XREF cont.;
_			No, they aren't. Does their line-of-sight cross
			any line, in the TOPOLOGICAL picture? Check all
			active lines!;

		 	LOOP(I3,1,MAXNOV,2)
				BEGIN "LP203" 

_				Is the line active?;

				IF ¬LACT("(I3+1)%2") THEN CONTINUE;

_				Yes, it is. Find end c.v:s.;

				ICV1←LVERCO[I3];
				ICV2←LVERCO[I3+1];

_				Does the line belong to our two c.v:s?;

				IF (I1-ICV1)*(I1-ICV2)*(I2-ICV1)*
					(I2-ICV2)=0 THEN CONTINUE;

_				No, it doesn't. Check intersection.;

				XREF8;

_				If the lines cross, we lose. Try next
					second c.v.;

				IF IP1<0∧IP2<0 THEN CONTINUE "LP202";

_				The lines do not cross. Check the next one.;

		 	        END "LP203";

_			All lines are cleared. Merge I1 and I2.;

			IF IDUM←MERCV(I1,I2,0) THEN GO L200;

_			After a merge, unfortunately, it is necessary to
			iterate all the way back (now or later), but on
			the other hand it won't happen very often!;
		_	End of inner final-merge loop...;

			END "LP202";

_		End of outer final-merge loop...;

		END "LP201";
_ XREF cont;

_	Finally check collinearities. Negate links between all active,
	unjoined s.v:s where there are unjoined	crossing lines in between.
	Delete unreciprocated links.;

	LOOP(I1,1,MAXNOV,1)
	   BEGIN
	   IL←(I1+1)%2;
	   IF LACT(IL)∧(I2←ABS LINK[I1]) THEN
	   IF ABS LINK[I2]≠I1 THEN LINK[I1]←0 ELSE
	   IF I2>I1
		∧LVERCO[I1]≠LVERCO[I2]
		∧(IPK[I1]
		∧RK[I1]<(R1←4*RCOL[I1])
		∧LVERCO[I1]≠LVERCO[IPK[I1]]
		∨IPK[I2]
		∧RK[I2]<R1
		∧LVERCO[I2]≠LVERCO[IPK[I2]])
			THEN BEGIN LINK[I1]←-I2; LINK[I2]←-I1 END;
	   END;
	END "XREF";
_ UNXREF;

_	This procedure disconnects all active lines from each other.
	It assumes no inactive lines are connected to c.v.s containing
	active lines.;

INTERNAL SIMPLE PROCEDURE UNXREF;
	BEGIN "UNXREF"
	LOOP(IA,1,MAXNOL,1) IF LACT(IA) THEN
		BEGIN
		IB←2*IA;
		LOOP(IC,0,1,1)
			BEGIN
			LVER[ID←IB-IC]←ID;
			RETCV(LVERCO[ID]);
			SVANG[ID]←360.;
			END
		END;
	LOOP(IA,1,MAXNOL,1) IF LACT(IA) THEN
		BEGIN
		IB←2*IA;
		LOOP(IC,0,1,1)
			BEGIN
			IE ← NEXVER;
			ID←IB-IC;
			LVERSI[IE]←ID;
			LVERCO[ID]←IE;
			XVCOR[IE]←XLCOR[ID];
			YVCOR[IE]←YLCOR[ID]
			END
		END;
	END "UNXREF";

END "SCENE";